home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / menus / vbmenu / menubmps.txt < prev   
Text File  |  1991-09-06  |  5KB  |  175 lines
  1. DefInt A-Z
  2.  
  3. 'Window API Function Declarations
  4. '
  5. Declare Function GetMenu% Lib "user" (ByVal hwnd%)
  6. Declare Function GetSubMenu% Lib "user" (ByVal hMenu%, ByVal nPos%)
  7. Declare Function GetMenuItemID% Lib "user" (ByVal hMenu%, ByVal nPos%)
  8. Declare Function ModifyMenu% Lib "user" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%, ByVal wIDNewItem%, ByVal lpNewItem&)
  9. Declare Function SetMenuItemBitmaps% Lib "user" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%, ByVal hBitmapUnchecked%, ByVal hBitmapChecked%)
  10. Declare Function TrackPopupMenu Lib "user" (ByVal hMenu, ByVal r1, ByVal X, ByVal Y, ByVal r2, ByVal hwnd, ByVal r3&)
  11. Declare Function GetSystemMenu Lib "user" (ByVal hwnd%, ByVal revert%) As Integer
  12. Const MF_BITMAP = &H4
  13.  
  14. Const CLR_MENUBAR = &H80000004
  15.  
  16. Const TRUE = -1, FALSE = 0
  17.  
  18. Dim TextItems$(4), LastSelection%, CurrentText%, hMenu%
  19.  
  20. Sub Form_Load ()
  21.   
  22. '* Obtain handle to the Forms top level menu
  23.  
  24.   hMenu% = GetMenu(hwnd)
  25.  
  26.   Static_Bitmaps_To_Menus
  27.    
  28. '* Initial String with text displayed when menus are selected.
  29. '* (Just so something happens when a menu is selected.)
  30.  
  31.    TextItems$(0) = "Writing Tools"
  32.    TextItems$(1) = "Fonts"
  33.    TextItems$(2) = "Books/Notes"
  34.    TextItems$(3) = "Printers"
  35.    TextItems$(4) = "Computers"
  36.  
  37. '* Set "Dynamic" menus submenus initial Menu text values
  38. '* to Fontname + Fontsize of each menu item
  39.  
  40.   For I% = 0 To 4
  41.     MSubMenu(I%).Caption = picture3(I%).FontName + Str$(picture3(I%).FontSize) + " Pnt"
  42.   Next I%
  43.  
  44. End Sub
  45.  
  46. Sub SubMenu_Click (Index As Integer)
  47.  
  48. Static LastSelection%
  49.    
  50. '* Set text to that of selected menu item and
  51. '* display the new text
  52.  
  53.   CurrentText% = Index
  54.   Form_Paint
  55.  
  56. '* Uncheck last selected item and check seledted item
  57.  
  58.   SubMenu(LastSelection%).Checked = FALSE  'Check selected menu
  59.   SubMenu(Index).Checked = TRUE            'UnCheck last selected menu
  60.  
  61.   LastSelection% = Index                   'Save current selection
  62.    
  63. End Sub
  64.  
  65. Sub MSubMenu_Click (Index As Integer)
  66.  
  67. Static LastSelection%
  68.  
  69. '* Reset forms FontSize to selected fontsize
  70. '* and redisplay current text
  71.  
  72.   FontSize = picture3(Index).FontSize
  73.   Form_Paint
  74.  
  75. '* Uncheck last selected item and check selected item
  76.  
  77.   MSubMenu(LastSelection%).Checked = FALSE
  78.   MSubMenu(Index).Checked = TRUE
  79.    
  80.   LastSelection% = Index
  81.  
  82. End Sub
  83.  
  84. Sub Create_Dynamic_Menu_Bitmaps ()
  85.   
  86.   For I% = 0 To 4
  87.   
  88.   '* Set the width and height of the Picture controls
  89.   '* based on their corresponding Menu items caption,
  90.   '* and the Picture controls Font and FontSize.
  91.   '* DoEvents() is neccessary to make new dimension
  92.   '* values to take affect prior to exiting this Sub.
  93.  
  94.     picture3(I%).Width = picture3(I%).TextWidth(MSubMenu(I%).Caption)
  95.     picture3(I%).Height = picture3(I%).TextHeight(MSubMenu(I%).Caption)
  96.     X% = DoEvents()
  97.  
  98.   '* Set Backcolor of Picture control to that of the
  99.   '* current system Menu Bar color, so Dynamic bitmaps
  100.   '* will appear as normal menu items when menu bar
  101.   '* color is changed via the control panel
  102.  
  103.     picture3(I%).BackColor = CLR_MENUBAR
  104.     
  105.   '* Print Text onto Picture control.  This text will
  106.   '* become the bitmap.
  107.  
  108.     picture3(I%).Print MSubMenu(I%).Caption
  109.  
  110.   Next I%
  111.  
  112. '* Obtain handle Second submenu
  113.  
  114.   hSubMenu% = GetSubMenu(hMenu%, 1)
  115.  
  116. '* - Set picture controls backgroup picture (Bitmap) to its Image.
  117. '*       Can't use the Image bitmap directly for some reason.
  118. '* - Get ID of sub menu
  119. '* - Replace menu text with bitmap from corresponding picture control
  120. '* - Replace bitmap for menu check mark with custom check mark bitmap
  121.  
  122.   For I% = 0 To 4
  123.     picture3(I%).Picture = picture3(I%).Image
  124.     menuId% = GetMenuItemID(hSubMenu%, I%)
  125.     X% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%, CLng(picture3(I%).Picture))
  126.     X% = SetMenuItemBitmaps(hMenu%, menuId%, 0, 0, CLng(picture2.Picture))
  127.   Next I%
  128.  
  129. End Sub
  130.  
  131. Sub Form_Paint ()
  132.   Cls
  133.   Print TextItems$(CurrentText%)
  134. End Sub
  135.  
  136. Sub CreateDynamic_Click ()
  137.   CreateDynamic.enabled = FALSE
  138.   Create_Dynamic_Menu_Bitmaps
  139. End Sub
  140.  
  141. Sub Static_Bitmaps_To_Menus ()
  142.  
  143. '* Obtain handle to first submenu
  144.  
  145.    hSubMenu% = GetSubMenu(hMenu%, 0)
  146.  
  147. '* - Get ID of each sub menu
  148. '* - Replace menu text with bitmap from corresponding picture control
  149. '* - Replace bitmap for menu check mark with custom check mark bitmap
  150.  
  151.    For I% = 0 To 4
  152.      menuId% = GetMenuItemID(hSubMenu%, I%)
  153.      X% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%, CLng(picture1(I%).Picture))
  154.      X% = SetMenuItemBitmaps(hMenu%, menuId%, 0, 0, CLng(picture2.Picture))
  155.    Next I%
  156.    
  157.    SubMenu(1).enabled = 0
  158.    hMenu% = GetSystemMenu(hwnd, 0)
  159.    menuId% = &HF120
  160.    X% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%, CLng(picture3(0).Picture))
  161.  
  162. End Sub
  163.  
  164. Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  165.  
  166.     ScaleMode = 3
  167.     InPixels = ScaleWidth
  168.     ScaleMode = 1
  169.     IX = (X + Left) \ (ScaleWidth \ InPixels)
  170.     IY = (Y + (Top + (Height - ScaleHeight - (Width - ScaleWidth)))) \ (ScaleWidth \ InPixels)
  171.     R = TrackPopupMenu(GetSubMenu(hMenu%, Button - 1), 0, IX, IY, 0, hwnd, 0)
  172.  
  173. End Sub
  174.  
  175.